# Definition and implementation of the Outline class.

class Outline {

	common eBBoxDist 4

	protected proc close {curves edgeBBox edgeMaxDist includeUpperLeftCorner}
	protected proc connect {curves}
	protected proc sideline {curves edgeBBox edgeMaxDist includeUpperLeftCorner}
	protected proc extend {curves edgeBBox edgeMaxDist}

	protected proc getSide {pt}
	protected proc getPoint {s}
	protected proc sideCompare {s1 s2}

	constructor {bbox upScale {curves {}}} {
		set iBBox $bbox
		set iUpScale $upScale
		set iCurves $curves
	}
	destructor {
		foreach curve $iCurves {itcl::delete object $curve}
	}

	method acquire {curves} {
		lappend iCurves $curves
	}

	method produceAct {}

	method getNrCurves {}
	method getCurveBBoxes {scaledUp xMirrored yMirrored tilted}
	method getCurveStartPoints {scaledUp xMirrored yMirrored tilted}
	method getCurveEndPoints {scaledUp xMirrored yMirrored tilted}

	method getUpScale {} {return $iUpScale}
	method getBoundingBox {scaledUp xMirrored yMirrored tilted}

	method close {includeUpperLeftCorner}
	method xMirror {}
	method yMirror {}
	method tilt {}
	method scale {xScale yScale}
	method translate {dx dy}

	protected method scaleUp {pt} {list [expr round([lindex $pt 0] * $eUpScale)] [expr round([lindex $pt 1] * $eUpScale)]}
	protected method scaleDown {pt} {list [expr [lindex $pt 0] / $eUpScale] [expr [lindex $pt 1] / $eUpScale]}
	protected method mirror {pt} {list [lindex $pt 0] [expr [expr [lindex $iBBox 3] + [lindex $iBBox 1]] - [lindex $pt 1]]}
	
	variable iBBox {}
	variable iUpScale 1
	variable iCurves {}
}

body Outline::close {curves edgeBBox edgeMaxDist includeUpperLeftCorner} {
	set openCurves {}
	set closedCurves {}
	foreach curve $curves {
		if {[$curve isClosed]} {
			lappend closedCurves $curve
		} else {
			lappend openCurves $curve
		}
	}

	# First portion are original curves, second portion is newly created.
	list $closedCurves [sideline $openCurves $edgeBBox $edgeMaxDist $includeUpperLeftCorner]
}

body Outline::connect {curves} {
	set connectedCurves {}
	foreach curve $curves {
		set start [$curve getStartPoint]
		set end [$curve getEndPoint]
		set idx -1
		set connectedIdx -1
		foreach connectedCurve $connectedCurves {
			incr connectedIdx
			if [$connectedCurve connectSelf $curve] {
				if {$idx > -1} {
					delete object $curve
					set connectedCurves [lreplace $connectedCurves $idx $idx]
					incr connectedIdx -1
				}
				set curve $connectedCurve
				set idx $connectedIdx
			}
		}
		if {$idx == -1} {
			lappend connectedCurves [Curve #auto [$curve cget -iPoints] [$curve cget -iOperators]]
		}
	}
	return $connectedCurves
}

body Outline::sideline {curves edgeBBox edgeMaxDist includeUpperLeftCorner} {
	set connectedCurves [connect $curves] 

	set sidePoints {}
	set looseCurves {}
	set edgeCurves {}
	foreach curve $connectedCurves {
		set startSidePoint [getSide [$curve getStartPoint]]
		set endSidePoint [getSide [$curve getEndPoint]]
		if {([llength $startSidePoint] == 0) || ([llength $endSidePoint] == 0)} {
			lappend looseCurves $curve
		} else {
			lappend edgeCurves $curve
			lappend sidePoints [lappend startSidePoint $curve 0] [lappend endSidePoint $curve 1]
		}
	}


	set sidePoints [lsort -command sideCompare $sidePoints]
	set edging $includeUpperLeftCorner
	if {$edging} {
		set leadCurve [Curve #auto "[lindex $edgeBBox 0] [lindex $edgeBBox 3]"]
		set leadSidePoint "0 0 0"
		lappend sidePoints [list 3 [expr [lindex $edgeBBox 3] - [lindex $edgeBBox 1]] 0 $leadCurve 1]
		lappend edgeCurves $leadCurve
	}

	foreach sidePoint $sidePoints {
		if {$edging} {
			if {[lindex $leadSidePoint 2] != 0} {
				set leadSidePoint [list [lindex $leadSidePoint 0] [lindex $leadSidePoint 1] 0]
				$leadCurve lineTo [getPoint $leadSidePoint]
			}
			while {[lindex $leadSidePoint 0] < [lindex $sidePoint 0]} {
				set leadSidePoint [list [expr [lindex $leadSidePoint 0] + 1] 0 0]
				$leadCurve lineTo [getPoint $leadSidePoint]
			}
			if {[lindex $leadSidePoint 1] < [lindex $sidePoint 1]} {
				set leadSidePoint [list [lindex $sidePoint 0] [lindex $sidePoint 1] 0]
				$leadCurve lineTo [getPoint $leadSidePoint]
			}
			if {[lindex $sidePoint 2] != 0} {
				$leadCurve lineTo [getPoint $sidePoint]
			}
			set edging 0
		} else {
			set leadSidePoint [lrange $sidePoint 0 2]
			set leadCurve [lindex $sidePoint 3]
			if {[lindex $sidePoint 4] == 0} {$leadCurve reverseSelf}
			set edging 1
		}
	}

	set connectedEdgeCurves [connect $edgeCurves]
	foreach curve $edgeCurves {delete object $curve}
	list $connectedEdgeCurves $looseCurves
}

body Outline::extend {curves edgeBBox edgeMaxDist} {
	foreach curve $curves {
		set startSidePoint [getSide [$curve getStartPoint]]
		if {([llength $startSidePoint] > 0) && ([lindex $startSidePoint 2] > 0)} {
			$curve reverseSelf
			$curve lineTo [getPoint [lreplace $startSidePoint 2 2 0]]
			$curve reverseSelf
		}
		set endSidePoint [getSide [$curve getEndPoint]]
		if {([llength $endSidePoint] > 0) && ([lindex $endSidePoint 2] > 0)} {
			$curve lineTo [getPoint [lreplace $endSidePoint 2 2 0]]
		}
	}
}

body Outline::getSide {pt} {
	upvar edgeBBox edgeBBox
	upvar edgeMaxDist edgeMaxDist
	set dist [expr [lindex $edgeBBox 3] - [lindex $pt 1]]
	if {$dist < $edgeMaxDist} {return [list 0 [expr [lindex $pt 0] - [lindex $edgeBBox 0]] $dist]}
	set dist [expr [lindex $edgeBBox 2] - [lindex $pt 0]]
	if {$dist < $edgeMaxDist} {return [list 1 [expr [lindex $edgeBBox 3] - [lindex $pt 1]] $dist]}
	set dist [expr  [lindex $pt 1] - [lindex $edgeBBox 1]]
	if {$dist < $edgeMaxDist} {return [list 2 [expr [lindex $edgeBBox 2] - [lindex $pt 0]] $dist]}
	set dist [expr [lindex $pt 0] - [lindex $edgeBBox 0]]
	if {$dist < $edgeMaxDist} {return [list 3 [expr [lindex $pt 1] - [lindex $edgeBBox 1]] $dist]}
	return {}
}

body Outline::getPoint {s} {
	upvar edgeBBox edgeBBox
	switch [lindex $s 0] 0 {
		return [list [expr [lindex $edgeBBox 0] + [lindex $s 1]] [expr [lindex $edgeBBox 3] - [lindex $s 2]]]
	} 1 {
		return [list [expr [lindex $edgeBBox 2] - [lindex $s 2]] [expr [lindex $edgeBBox 3] - [lindex $s 1]]]
	} 2 {
		return [list [expr [lindex $edgeBBox 2] - [lindex $s 1]] [expr [lindex $edgeBBox 1] + [lindex $s 2]]]
	} 3 {
		return [list [expr [lindex $edgeBBox 0] + [lindex $s 2]] [expr [lindex $edgeBBox 1] + [lindex $s 1]]]
	}
}

body Outline::sideCompare {s1 s2} {
	set diff [expr [lindex $s1 0] - [lindex $s2 0]]
	if {$diff != 0} {return $diff}
	set diff [expr [lindex $s1 1] - [lindex $s2 1]]
	if {$diff != 0} {return $diff}
	expr [lindex $s1 2] - [lindex $s2 2]
}

body Outline::read {fileSpec} {
	set I [iexpect::Expect #auto -white -file $fileSpec]

	set colorId 0
	set outline {}
	set curving 0

	$I expect line "^%%BoundingBox: ?($eNumber $eNumber $eNumber $eNumber)$" {
		set iBBox [eval list [scaleUp [lrange [$I get match 1] 0 1]] [scaleUp [lrange [$I get match 1] 2 3]]] 
		$I continue
	} "^($eNumber $eNumber $eNumber $eNumber) \[kK\]$" {
		assert {!$curving} "Color change inside curve"
		if {[llength $outline] > 0} {
			$iOutlines set $colorId [concat [$iOutlines on $colorId {}] $outline]
		}
		set color [$I get match 1]
		set colorId [expr [lsearch $iColors $color] + 1]
		if {$colorId == 0} {
			lappend iColors $color
			set colorId [llength $iColors] 
		}
		set outline {}
		$I continue
	} "^($eNumber $eNumber) m$" {
		assert {!$curving} "moveto inside curve"
		set curving 1
		set curve [Curve #auto [scaleUp [$I get match 1]]]
		$I continue
	} "^($eNumber $eNumber) l$" {
		assert $curving "lineto outside curve"
		$curve lineTo [scaleUp [$I get match 1]]
		$I continue
	} "^($eNumber $eNumber) ($eNumber $eNumber) ($eNumber $eNumber) c$" {
		assert $curving "curveto outside curve"
		$curve curveTo [scaleUp [$I get match 1]] [scaleUp [$I get match 2]] [scaleUp [$I get match 3]]
		$I continue
	} "^\[Sf\]$" {
		assert $curving "stroke outside curve"
		set curving 0
		lappend outline $curve
		$I continue
	} default {
		$I continue
	}

	if {[llength $outline] > 0} {
		$iOutlines set $colorId [concat [$iOutlines on $colorId {}] $outline]
	}
	
	delete object $I
}

body Outline::summarize {} {
	set idx 0
	foreach color $iColors {
		puts "[incr idx]: CMYK = $color - #curves = [llength $iOutlines($idx)]" 
	}
}

body Outline::detailContents {colorId} {
	assert {($colorId > 0) && ($colorId <= [llength $iColors])} "No outline defined in color $colorId"

	puts "$colorId: CMYK = [lindex $iColors [expr $colorId - 1]] - #curves = [llength $iOutlines($colorId)]"
	foreach curve $iOutlines($colorId) {
		set bbox [$curve getBBox]
		set ul [scaleDown [mirror "[lindex $bbox 0] [lindex $bbox 3]"]]
		set lr [scaleDown [mirror "[lindex $bbox 2] [lindex $bbox 1]"]]
		puts "Curve from [scaleDown [mirror [$curve getStartPoint]]] to [scaleDown [mirror [$curve getEndPoint]]] between $ul and $lr"
	}
}

body Outline::getBoundingBox {} {
	return "[scaleDown [lrange $iBBox 0 1]] [scaleDown [lrange $iBBox 2 3]]"
}

body Outline::writeContents {colorId fileId updates} {
	set params [iarray::Array #auto $updates]
	switch [$params of operation] "fill" {
		writeFillContents $colorId $fileId [$params on operator S] [$params on offset "0 0"]
	} "stroke" {
		writeStrokeContents $colorId $fileId [$params on operator S] [$params on offset "0 0"]
	} default {
		writePointContents $colorId $fileId [$params on operator S] [$params on offset "0 0"] [$params on format raw] [$params on identifiers {}]
	}
	delete object $params
}

body Outline::writeFillContents {colorId fileId operator offset} {
	assert {($colorId > 0) && ($colorId <= [llength $iColors])} "No outline defined in color $colorId"

	set allCurves [close $iOutlines($colorId) \
		$iBBox [expr $eBBoxDist * $eUpScale] [expr $iUpperLeftCornerColorId == $colorId]]
	
	set looseCurves [lindex [lindex $allCurves 1] 1]
	if {[llength $looseCurves] > 0} {
		inform "Discarding [llength $looseCurves] loose curves"
		foreach curve $looseCurves {
			inform "From [scaleDown [mirror [$curve getStartPoint]]] to [scaleDown [mirror [$curve getEndPoint]]]"
			delete object $curve
		} 
	}
	set iOutlines($colorId) [concat [lindex [lindex $allCurves 1] 0] [lindex $allCurves 0]]

	puts $fileId "s"
	if {([lindex $offset 0] != 0) || ([lindex $offset 1] != 0)} {
		puts $fileId "$offset translate"
	} 
	foreach curve $iOutlines($colorId) {
		puts $fileId "[$curve getStartPoint] m"
		$curve forEachPiece piece {
			puts $fileId "$piece l"
		} {
			puts $fileId "[eval concat $piece] c"
		}
		puts $fileId $operator
	}
	puts $fileId "r"
}

body Outline::writeStrokeContents {colorId fileId operator offset} {
	assert {($colorId > 0) && ($colorId <= [llength $iColors])} "No outline defined in color $colorId"

	extend $iOutlines($colorId) $iBBox [expr $eBBoxDist * $eUpScale]

	puts $fileId "s"
	if {([lindex $offset 0] != 0) || ([lindex $offset 1] != 0)} {
		puts $fileId "$offset t"
	} 
	puts $fileId "1 $eUpScale div dup x"
	foreach curve $iOutlines($colorId) {
		puts $fileId "[$curve getStartPoint] m"
		$curve forEachPiece piece {
			puts $fileId "$piece l"
		} {
			puts $fileId "[eval concat $piece] c"
		}
		puts $fileId $operator
	}
	puts $fileId "r"
}

body Outline::writePointContents {colorId fileId operator offset format identifiers} {
	assert {($colorId > 0) && ($colorId <= [llength $iColors])} "No outline defined in color $colorId"

	if {![llength $identifiers]} { 
		foreach curve $iOutlines($colorId) {
			set bbox [$curve getBBox]
			puts $fileId "[expr ([lindex $bbox 0] + [lindex $bbox 2]) / 2 / $eUpScale + [lindex $offset 0]]\
				[expr ([lindex $bbox 1] + [lindex $bbox 3]) / 2 / $eUpScale + [lindex $offset 1]] $operator"
		}
	} else {
		assert {[llength $identifiers] >= [llength $iOutlines($colorId)]} "Not enough names listed. Expected [llength $iOutlines($colorId)], got [llength $identifiers]."
		assert {[llength $identifiers] <= [llength $iOutlines($colorId)]} "Too many names listed. Expected [llength $iOutlines($colorId)], got [llength $identifiers]."

		switch $format string {
			set identifiers [regsub -all "\[^ \]+" $identifiers "(&)"]
		} name {
			set identifiers [regsub -all "\[^ \]+" $identifiers "/&"]
		}

		foreach name $identifiers curve $iOutlines($colorId) {
			set bbox [$curve getBBox]
			puts $fileId "[expr ([lindex $bbox 0] + [lindex $bbox 2]) / 2 / $eUpScale + [lindex $offset 0]]\
				[expr ([lindex $bbox 1] + [lindex $bbox 3]) / 2 / $eUpScale + [lindex $offset 1]] $name $operator"
		}
	}
}
